COMMENT ⊗   VALID 00006 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00002 00002	 Routines to plot performance of the implementations
C00008 00003	 Routines to plot performance of the implementations (hardcopy)
C00012 00004	 For each benchmark:
C00019 00005	(declare (special *logp* *rawp*))
C00025 00006	 This is for hardcopy:
C00027 ENDMK
C⊗;
;;; Routines to plot performance of the implementations

(eval-when (load) 
	   (fasload ddmid fas dsk (sys rod)))
(declare (special *chan* *points* *best* *scale* *vertical-lines*)
	 (setq defmacro-for-compiling ())
	 (mapex t)
	 (*expr ddinit screen erase line dpyup gddchn rddchn))

;;; *chan* is a global variable containing the channel number

(setq *scale* 1.0)
(setq *vertical-lines* ())

;;; Places a vertical tick yeps high at (x,y)

(defun v-tick (x y yeps)
       (let ((half-yeps (//$ yeps 2.0)))
	    (line x (-$ y half-yeps) x (+$ y half-yeps))))

;;; Places a horizontal tick xeps high at (x,y)

(defun h-tick (x y xeps)
       (let ((half-xeps (//$ xeps 2.0)))
	    (line (-$ x half-xeps) y (+$ x half-xeps) y)))

;;; This takes a set of points of the form:
;;; (...(y1...yn)...) = L
;;; sets up the co-ordinates for the graph. If L is n long, then
;;; the x-axis goes from 0 to n. The y-axis goes from the minimum of yi to the
;;; maximum of yi.

(defmacro first-not-null (l count)
	  (let ((g (gensym)))
	       `(do ((l ,l (cdr l))
		     (,g ,count (1+ ,g)))
		    ((or (null l)
			 (not (null (car l))))
		     (setq ,count ,g)
		     l))))
(defmacro incf (x)
	  `(setq ,x (1+ ,x)))

(defmacro adjust-fun (x)
	  `(+$ 1.0 ,x))

(defmacro graph-macro (line ddinit dpyup screen erase vtick htick)
       `(cond ((null points)
	      (terpri)
	      (princ "Not enough points")
	      (terpri))
	     (t (let ((fhx (+$ 1.0 (float (length points))))
		      (ymin (car (car points))) 
		      (ymax (car (car points)))(fhy 0.0)
		      (xeps 0.0) (yeps 0.0))
		     (do ((l points (cdr l)))
			 ((null l))
			 (do ((p (car l) (cdr p)))
			     ((null p))
			     (cond ((numberp (car p))
				    (cond ((numberp ymin)
					   (cond ((lessp (car p) ymin)
						  (setq ymin (car p)))
						 ((greaterp (car p) ymax)
						  (setq ymax (car p)))))
					  (t (setq ymin (car p))
					     (setq ymax (car p))))))))
		     (setq fhy (+$ 1.0 (*$ 1.1 (-$ ymax ymin))))
		     (setq xeps (//$ fhx 100.0))
		     (setq yeps (//$ fhy 100.0))
		     (setq *chan* (gddchn -1))
		     (,ddinit)
		     (,screen 0.5 0.5 (*$ 1.2 (*$ (float *scale*) fhx))
			     (*$ 1.2 (*$ (float *scale*) fhy)))
		     (,erase *chan*)
		     (,line 1.0 1.0 1.0 fhy)
		     (,line 1.0 1.0 fhx 1.0)
		     (let ((ox 1.0)
			   (oy 0.0))
		     (do ((l points (cdr l))
			  (n 2 (1+ n)))
			 ((null l)
			  (dpyup *chan*))
			 (setq ox (float n))
			 (setq oy (adjust-fun (car (car l))))
			 (do ((p (cdar l) (cdr p)) 
			      (nx (float n))
			      (ny 0.0))
			     ((null p)
			      (cond (*vertical-lines*
				     (,line ox oy nx ny))
				    (t
				     (,vtick ox 1.0 yeps))))
			     (cond ((not (null (car p)))
				    (setq ny (adjust-fun (car p)))
				    (cond (*vertical-lines*
					   (,line ox oy nx ny))
					  (t (,vtick ox 1.0 yeps)))
				    (setq ox nx oy ny))))))
		(let ((nl 2)(nm 3))
		     (do ((l (first-not-null points nl) 
			     (progn (incf nl) (first-not-null (cdr l) nl)))
			  (m (first-not-null (cdr points) nm) 
			     (progn (incf nm) (first-not-null (cdr m) nm))))
			      ((null m) (,dpyup *chan*) 
					*chan*)
			      (do ((x (car l) (cdr x))
				   (y (car m) (cdr y)))
				  ((or (null x)
				       (null y)) t)
				  (cond ((and (not (null (car x)))
					      (not (null (car y))))
           				 (,line (float nl) (adjust-fun (car x))
  						(float nm) (adjust-fun (car y))))))))))))

(defun init ()
       (erase *chan*)
       (rddchn *chan*))


(defun graph (points)
       (declare (flonum fhx fhy xeps yeps))
       (graph-macro line ddinit dpyup screen erase v-tick h-tick))

;;; Routines to plot performance of the implementations (hardcopy)

(eval-when (load) 
	   (fasload god fas dsk (sys ml)))
(declare (special *chan* *points* *best* *scale*)
	 (setq defmacro-for-compiling ())
	 (mapex t)
	 (*expr ddinit-g screen-g erase-g line-g dpyup-g gddchn-g rddchn-g))

;;; *chan* is a global variable containing the channel number

(setq *scale* 1.0)

;;; Places a vertical tick yeps high at (x,y)

(defun v-tick-g (x y yeps)
       (let ((half-yeps (//$ yeps 2.0)))
	    (line-g x (-$ y half-yeps) x (+$ y half-yeps))))

;;; Places a horizontal tick xeps high at (x,y)

(defun h-tick-g (x y xeps)
       (let ((half-xeps (//$ xeps 2.0)))
	    (line-g (-$ x half-xeps) y (+$ x half-xeps) y)))

;;; This takes a set of points of the form:
;;; (...(y1...yn)...) = L
;;; sets up the co-ordinates for the graph. If L is n long, then
;;; the x-axis goes from 0 to n. The y-axis goes from the minimum of yi to the
;;; maximum of yi.

(defun graph-g (points)
       (declare (flonum fhx fhy xeps yeps))
       (graph-macro line-g ddinit-g dpyup-g screen-g progn v-tick-g h-tick-g))
;;; For each benchmark:
;;;(...(benchmark
;;;     ((blankline))
;;;     ((indent 1) "Benchmark 3" (entry (f entry)))
;;;     ((center) "Random Text"))...)
;;;
;;; For each implementation:
;;;(...(impl "Top-row Information")...)


(declare (special *data* *benchmarks* *all-implementations*
		  *impl-order* *invert* *sortp*
		  *all-implementations-flattened* *max-length*
		  *selectors* *subset-relationships* *all-benchmarks*))
(declare (mapex t))

(setq *invert* () *sortp* ())

(declare (special *benchmark-info*))

(defun get-bench-data (bench impl)
       (cadr (assq impl (cdr (assoc bench *data*)))))

(defun filter-to-show-same (l)
       (let ((template
	      (do ((templ
		    (mapcar #'(lambda (()) t)
			    (car l))) 
		   (l l (cdr l)))
		  ((null l) templ)
		  (do ((x (car l) (cdr x)) 
		       (templ templ (cdr templ)))
		      ((null templ))
		      (cond ((null (car x))
			     (setf (car templ) ())))))))
	    (do ((x l (cdr x)))
		((null x) 
		 (cond (*sortp*
			(unzip (sort (zip l *impl-order*) #'avelessp)))
		       (t l)))
		(do ((y (car x) (cdr y))
		     (templ template (cdr templ)))
		    ((null y))
		    (cond ((null (car templ))
			   (setf (car y) ())))))))

(defun average(l)
       (do ((l (car l) (cdr l))
	    (ave 0.0)
	    (n 0))
	   ((null l)(//$ ave (float n)))
	   (cond ((numberp (car l))
		  (setq ave (+$ (float (car l)) ave))
		  (setq n (1+ n))))))

(defun avelessp (x y)
       (lessp (average x)(average y)))

(defun zip (l1 l2)
       (mapcar #'cons l1 l2))

(defun unzip (l)
       (setq *impl-order*
	     (mapcar #'cdr l))
       (mapcar #'car l))

(defun invert (l)
       (let ((new (mapcar #'(lambda (x) ()) (car l))))
	    (do ((l l (cdr l)))
		((null l)(flush-lists-of-nil new))
		(do ((cl (car l) (cdr cl))
		     (x new (cdr x)))
		    ((null cl))
		    (setf (car x) `(,(car cl) .,(car x)))))))


(defun possibly-invert (l)
       (cond (*invert* (invert l))
	     (t l)))

(defmacro all-nil (l)
	  `(do ((l ,l (cdr l)))
	       ((null l) t)
	       (cond ((car l) (return ())))))

(defun flush-lists-of-nil (l)
       (let* ((dyke (cons () *impl-order*))
	      (front dyke))
	    (prog1
	     (mapcan #'(lambda (x)
			       (cond ((all-nil x)
				      (setf (cdr dyke) (cddr dyke))
				      ())
				     (t (setq dyke (cdr dyke))
					(ncons x))))
		     l) 
	     (setq *impl-order* (cdr front)))))
(declare (special *logp* *rawp*))

;;; Here's some specials and what they do:

;;; *rawp* - if T, then raw data it plotted, otherwise scaled to best
;;; *logp* - if T, then logarithmic scale on y-axis
;;; *invert* - if T, then x-axis is benchmarks, otherwise implementations
;;; *impl-order* - when implementations are on the x-axis, this returns
;;; 	           the order in which they are placed
;;; *sortp* - if T, graphs are sorted.

(setq *logp* () *rawp* ())

(defun graph-impls-real (implementations)
       (graph-impls implementations 'real))

(defun graph-impls-cpu (implementations)
       (graph-impls implementations 'cpu))

(defun graph-impls (implementations type)
 (let ((best-alist
	(or *logp* *rawp*
	    (mapcar #'(lambda (bench)
			      `(,(car bench) 
				,(find-best (car bench) (caddr bench)
					    implementations
					    type)))
		*all-benchmarks*))))
      (and (boundp '*chan*) (init))
      (setq *impl-order* (cond (*invert* (mapcar #'car *all-benchmarks*))
			       (t implementations)))
      (graph
       (filter-to-show-same
	(possibly-invert
	 (mapcan #'(lambda (impl)
			   (let ((info 
				  (make-a-column impl best-alist type)))
				(cond (info (ncons info)))))
		 implementations))))
       *chan*))

(defmacro float-it (x)
	  `(setq ,x (float ,x)))

(defun make-a-column (impl best-alist type)
       (mapcar
	#'(lambda (bench)
		  (let ((info 
			 (funcall (caddr bench)
				  (get-bench-data 
				   (find-superset-bench (car bench)) 
				   (find-superset-impl impl))))
			(best (or *logp* *rawp* 
				  (cadr (assq (car bench) best-alist)))))
		       (caseq type
			      (real
			       (let ((entry (real-time impl info)))
				    (cond (*logp*
					   (cond ((and 
						   (numberp entry)
						   (progn (float-it entry)
							  (lessp 0.0 entry)))
						  (log (+$ 2.71828185 entry)))
						 (t ())))
					  (t 
					   (cond 
					    ((numberp entry)
					     (cond 
					      (*rawp* entry)
					      ((numberp best)
					       (//$ (float entry) best))
					      (t ()))))))))
			      (cpu
			       (let ((entry (cpu-time impl info)))
				    (cond 
				     (*logp*
				      (cond 
				       ((and 
					 (numberp entry)
					 (progn
					  (float-it entry)
					  (lessp 0.0 entry)))
					(log (+$ 2.71828185 entry)))
				       (t ())))
				     (t 
				      (cond 
				       ((numberp entry)
					(cond (*rawp* entry)
					      ((numberp best)
					       (//$ (float entry) best))
					      (t ()))))))))
				    (t ()))))
	*all-benchmarks*))

(defun find-best (bench fun impls type)
       (let ((data
	      (mapcan #'(lambda (impl)
				(let ((info 
				       (funcall fun
						(get-bench-data 
						 (find-superset-bench bench) 
						 (find-superset-impl impl)))))
				     (caseq type
					    (real
					     (let ((entry (real-time impl info)))
						  (cond ((numberp entry)
							 (ncons (float entry))))))
					    (cpu
					     (let ((entry (cpu-time impl info)))
						  (cond ((numberp entry)
							 (ncons (float entry))))))
					    (t ()))))
		      impls)))
	    (do ((data (cdr data) (cdr data))
		 (best (car data)))
		((null data) best)
		(cond ((lessp (car data) best)
		       (setq best (car data)))))))

(defun find-superset-bench (bench)
       (do ((b *subset-relationships* (cdr b)))
	   ((null b) ())
	   (cond ((memq bench (cadr (car b)))
		  (return (car (car b)))))))

(defun find-superset-impl (impl)
       (cadr (assq impl *all-implementations-flattened*)))
;;; This is for hardcopy:

(defun graph-impls-real-g (implementations)
       (graph-impls-g implementations 'real))

(defun graph-impls-cpu-g (implementations)
       (graph-impls-g implementations 'cpu))

(defun graph-impls-g (implementations type)
 (let ((best-alist
	(or *logp*
	     (mapcar #'(lambda (bench)
			       `(,(car bench) 
				 ,(find-best (car bench) (caddr bench)
					     (mapcar #'car *all-implementations-flattened*)
					     type))) 
		     *all-benchmarks*))))
      (setq *impl-order* (cond (*invert* (mapcar #'car *all-benchmarks*))
			       (t implementations)))
      (graph-g
       (filter-to-show-same
	(possibly-invert
	 (mapcan #'(lambda (impl)
			   (let ((info 
				  (make-a-column impl best-alist type)))
				(cond (info (ncons info)))))
		 implementations))))
      t))